unit Functions;

interface

uses
  SysUtils, Math;

function AGE(EMSO: PChar; var Year: Integer): Double; cdecl;
function BIN_NOT(var Value: Integer): Integer; cdecl;
function BIN_SHL(var Value, Position: Integer): Integer; cdecl;
function BIN_SHR(var Value, Position: Integer): Integer; cdecl;
function BIN_GET_BIT(var Value, BitPosition: Integer): Integer; cdecl;
function BIN_GET_BIT_64(var Value: Int64; var BitPosition: Integer): Integer; cdecl;
function BIN_SET_BIT(var Value, BitPosition, BitValue: Integer): Integer; cdecl;
function BIN_SET_BIT_64(var Value: Int64; var BitPosition, BitValue: Integer): Int64; cdecl;
function BIN_GET_BITS(var Value, FromBitPosition, ToBitPosition: Integer): Integer; cdecl;
function BIN_SET_BITS(var Value, FromBitPosition, ToBitPosition, BitValue: Integer): Integer; cdecl;

implementation

function AGE(EMSO: PChar; var Year: Integer): Double;
var
  EMSOStr: string;
  BirthYear: Integer;
begin
  try
    EMSOStr := string(EMSO);
    BirthYear := StrToIntDef(Copy(EMSOStr, 5, 3), 0);
    if BirthYear > 500 then
      BirthYear := BirthYear + 1000
    else
      BirthYear := BirthYear + 2000;
    Result := Year - BirthYear;
  except
    Result := 0;
  end;
end;

function BIN_NOT(var Value: Integer): Integer;
begin
  Result := not Value;
end;

function BIN_SHL(var Value, Position: Integer): Integer;
begin
  Result := Value shl Position;
end;

function BIN_SHR(var Value, Position: Integer): Integer;
begin
  Result := Value shr Position;
end;

function BIN_GET_BIT(var Value, BitPosition: Integer): Integer;
begin
  if (Value and (1 shl (BitPosition - 1))) = 0 then
    Result := 0
  else
    Result := 1;
end;

function BIN_GET_BIT_64(var Value: Int64; var BitPosition: Integer): Integer;
begin
  if (Value and (1 shl (BitPosition - 1))) = 0 then
    Result := 0
  else
    Result := 1;
end;

function BIN_SET_BIT(var Value, BitPosition, BitValue: Integer): Integer;
begin
  if BitValue = 1 then
    Result := Value or (1 shl (BitPosition - 1))
  else
    Result := Value and (not (1 shl (BitPosition - 1)));
end;

function BIN_SET_BIT_64(var Value: Int64; var BitPosition, BitValue: Integer): Int64;
begin
  if BitValue = 1 then
    Result := Value or (1 shl (BitPosition - 1))
  else
    Result := Value and (not (1 shl (BitPosition - 1)));
end;

function BIN_GET_BITS(var Value, FromBitPosition, ToBitPosition: Integer): Integer;
var
  i: Integer;
  BitPosition: Integer;
begin
  Result := 0;
  for i := FromBitPosition to ToBitPosition do
  begin
    BitPosition := i;
    Result := Result + BIN_GET_BIT(Value, BitPosition) * (1 shl (BitPosition - 1));
  end;
end;

function BIN_SET_BITS(var Value, FromBitPosition, ToBitPosition, BitValue: Integer): Integer;
var
  i: Integer;
  BitPosition: Integer;
begin
  Result := Value;
  for i := FromBitPosition to ToBitPosition do
  begin
    BitPosition := i;
    Result := BIN_SET_BIT(Result, BitPosition, BitValue);
  end;
end;

end.
 